home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Stacks / Hyper Utilities / XCMD's⁄XFCN's / HyperSound / BeepSnd.p next >
Encoding:
Text File  |  1988-01-09  |  2.6 KB  |  128 lines  |  [TEXT/ttxt]
  1. {$R-}
  2.  
  3. {$S BeepSound }     { Segment name must be the same as the command name. }
  4.  
  5. UNIT DummyUnit;
  6.  
  7. INTERFACE
  8.  
  9. USES MemTypes, QuickDraw, OSIntf, toolIntf, hyperxcmd, sane;
  10.  
  11. PROCEDURE ENTRYPOINT(paramPtr: XCmdPtr);
  12.     
  13. IMPLEMENTATION
  14.  
  15. TYPE Str31 = String[31];
  16.  
  17. PROCEDURE BeepSnd(paramPtr: XCmdPtr);                             FORWARD;
  18.  
  19.     PROCEDURE ENTRYPOINT(paramPtr: XCmdPtr);
  20.     BEGIN
  21.         BeepSnd(paramPtr);
  22.     END;
  23.  
  24.     PROCEDURE BeepSnd(paramPtr: XCmdPtr);
  25. TYPE
  26.     T1 = RECORD
  27.         Typ: Integer;
  28.         Sz: Integer;
  29.         F: ARRAY [1..100] OF RECORD
  30.             Typ: Integer;
  31.             Modi: LongInt;
  32.             END;
  33.         END;
  34.     T2 = RECORD
  35.         Sz: Integer;
  36.         F: ARRAY [1..100] OF RECORD
  37.             Cmd: Integer;
  38.             Mod1: Integer;
  39.             Mod2: LongInt;
  40.             END;
  41.         END;
  42.     T3 = RECORD
  43.         X: LongInt;
  44.         N: LongInt;
  45.         Rate: LongInt;
  46.         St, En: LongInt;
  47.         base: integer;
  48.         END;
  49.     P1 = ^T1;
  50.     P2 = ^T2;
  51.     P3 = ^T3;
  52.     H1 = ^P1;
  53. VAR Res: H1;
  54.     Ps: P2;
  55.     Pt: P3;
  56.     i,j: Integer;
  57.     ch, fnd: boolean;
  58.     iff: longint;
  59.     uff: integer;
  60. BEGIN
  61.     i := 0;
  62.     while true do begin
  63.         i := i+1;
  64.         handle(res) := get1indresource ('snd ', i);
  65.         ch := false;
  66.         uff := 0;
  67.         if res = nil then exit(beepsnd);
  68.         if (res^^.typ = 1) OR (res^^.typ = 2) then begin
  69.             IF Res^^.Typ = 2 then begin
  70.                 res^^.Typ := 1;
  71.                 res^^.Sz := 0;
  72.                 ch := true;
  73.                 end;
  74.             fnd := false;
  75.             for j := 1 to res^^.sz do
  76.                 if res^^.f[j].Typ in [1,3,5,7,9] then
  77.                     fnd := true;
  78.             if not fnd then begin
  79.                 res^^.sz := res^^.sz+1;
  80.                 iff := munger (handle(res), 4, nil,0,@iff, 6);
  81.                 uff := uff+6;
  82.                 res^^.f[1].Typ := 5;
  83.                 res^^.f[1].Modi := 0;
  84.                 end;
  85.             hlock(handle(res));
  86.             ptr(Ps) := ptr(ord4(res^)+4+6*res^^.sz);
  87.             if (ps^.sz = 1) & 
  88.                 ((ps^.f[1].cmd = $8050) | (ps^.f[1].cmd = $8051)) then begin
  89.                 ps^.f[1].cmd := $8050;
  90.                 uff := uff+8;
  91.                 hUnlock(handle(res));
  92.                 iff := munger (handle(res), 6+6*res^^.sz+8, nil,0,@iff, 8);
  93.                 hlock(handle(res));
  94.                 ptr(Ps) := ptr(ord4(res^)+4+6*res^^.sz);
  95.                 ptr(pt) := ptr(uff+ps^.f[1].Mod2 + ord4(res^));
  96.                 Ps^.sz := 2;
  97.                 Ps^.f[2].Cmd := 40;
  98.                 Ps^.f[2].mod1 := num2integer(2000.0 * Pt^.N * exp2 ((pt^.base-60.0)/12.0) * (65536.0 / Pt^.Rate));
  99.                 Ps^.f[2].Mod2 := $FF00003C; (* middle c *)
  100.                 if (pt^.st = 0) & (pt^.en = 0) then begin
  101.                     pt^.en := pt^.n - 1;
  102.                     pt^.st := pt^.en - 1;
  103.                     end;
  104.                 ch := true;
  105.                 end;
  106.             for j := 1 to ps^.sz do 
  107.                 if ps^.f[j].cmd < 0 then begin
  108.                     ch := true;
  109.                     ps^.f[j].Mod2 := ps^.f[j].Mod2 + uff;
  110.                     end;
  111.             hUNlock(handle(res));
  112.             if ch then begin
  113.                 changedresource(handle(res));
  114.                 writeresource(handle(res));
  115.                 end;
  116.             end;
  117.         end;
  118. END;
  119.  
  120. END.
  121.  
  122.  
  123.  
  124. (* compile and link:
  125. pascal beepsnd.p -i "{XCMDs}"
  126. link -o 80:HyperSound -rt XCMD=1 -sg BeepSound=Main,SANELib -m ENTRYPOINT BeepSnd.p.o {libraries}interface.o {plibraries}sanelib.o
  127. *)
  128.